unit ICore.Utils.XML;
{Author: XProger}
{Update: Igroman}

interface

uses
  {$IFDEF ICORE}
  ICore.Utils,
  {$ELSE}
  SysUtils,
  {$ENDIF}
  ICore.Stream;

{$IFNDEF ICORE}
const
  CRLF  = #13#10;
  TAB   = #9;
{$ENDIF}

type
  {$IFNDEF ICORE}
  TCharsSet = TSysCharSet;
  {$ENDIF}

  TXMLParamValueAnsi = AnsiString; // Variant

  PXMLParamAnsi = ^TXMLParamAnsi;
  TXMLParamAnsi = record
    Name  : AnsiString;
    Value : AnsiString;
  end;

{$REGION 'TXMLParamsAnsi = class'}
  PXMLParamsAnsi = ^TXMLParamsAnsi;
  TXMLParamsAnsi = class
    constructor Create; overload;
    constructor Create(const Text: AnsiString); overload;
    destructor Destroy; override;
  protected
    FParams: array of TXMLParamAnsi;
    function GetParam(const Name: AnsiString): TXMLParamAnsi;
    function GetParamI(Idx: Integer): TXMLParamAnsi;
  public
    procedure Clear;
    procedure AddParam(const Name: AnsiString; const Value: AnsiString);
    function Count: Integer;
    property Param[const Name: AnsiString]: TXMLParamAnsi read GetParam; default;
    property ParamI[Idx: Integer]: TXMLParamAnsi read GetParamI;
  end;
{$ENDREGION}

{$REGION 'TXMLAnsi = class'}
  PXMLAnsi = ^TXMLAnsi;
  TXMLAnsi = class
    constructor Create; overload;
    constructor Create(const FileName: {$IFDEF ICORE} AnsiString {$ELSE} string {$ENDIF};
                        const ClearData: Boolean = False); overload;
    constructor Create(const Text: AnsiString; BeginPos: Integer); overload;
    destructor Destroy; override;
  protected
    FFileName: {$IFDEF ICORE} AnsiString {$ELSE} string {$ENDIF};
    FNode    : array of TXMLAnsi;
    FTag     : AnsiString;
    FContent : AnsiString;
    FDataLen : Integer;
    FParams  : TXMLParamsAnsi;
    function GetNode(const TagName: AnsiString): TXMLAnsi;
    function GetNodeI(Idx: Integer): TXMLAnsi;
    procedure Parse(const Text: AnsiString; BeginPos: Integer);
  public
    procedure Clear; inline;
    procedure ClearParams; inline;
    function LoadFromFile(const FileName: {$IFDEF ICORE} AnsiString {$ELSE} string {$ENDIF};
                            const ClearData: Boolean = False): Boolean; overload;
    function LoadFromFile(const FileName: {$IFDEF ICORE} AnsiString {$ELSE} string {$ENDIF};
                            const Size: LongInt;
                            const ClearData: Boolean = False): Boolean; overload;
    function SaveToFile(const FileName: AnsiString): Boolean;
    function GetIDNode(const Tag: AnsiString): Integer;
    function AddNode(const Tag: AnsiString): TXMLAnsi;
    function DelNode(const Tag: AnsiString): Boolean; overload;
    function DelNode(const Index: LongInt): Boolean; overload;
    function Count: Integer;
    function ExistNode(const Tag: AnsiString): Boolean;
    property FileName: {$IFDEF ICORE} AnsiString {$ELSE} string {$ENDIF} read FFileName;
    property Tag: AnsiString read FTag write FTag;
    property Content: AnsiString read FContent write FContent;
    property DataLen: Integer read FDataLen;
    property Params: TXMLParamsAnsi read FParams;
    property Node[const TagName: AnsiString]: TXMLAnsi read GetNode; default;
    property NodeI[Idx: Integer]: TXMLAnsi read GetNodeI;
  end;
{$ENDREGION}

{$REGION 'System'}
{$IFNDEF ICORE}
function ReplaceChars(const Str: string;
                        const Chars: TCharsSet;
                        const Replace: Char): string;// inline;
function ReplaceStr(const Str: string;
                      const SubStr: string;
                      const Replace: string): string;
function ReplaceStrAnsi(const Str: AnsiString;
                          const SubStr: AnsiString;
                          const Replace: AnsiString): AnsiString;
{$ENDIF}
{$ENDREGION}

implementation

const
  UTF16_HEADER : Word = $FEFF;
  NullParamAnsi : TXMLParamAnsi = (Name: ''; Value: '');

{$REGION 'System'}

{$REGION 'TrimCopy'}

function TrimCopy(const Text: string; Index, Count: Integer): string;
const
  TrimChars : TCharsSet = [#9, #10, #13, #32, '"'];
var
  i : Integer;
begin
try
  for i := Index to Index + Count - 1 do
   {$IFDEF ICORE}
   if TUtils.CharsInSet(Text[i], TrimChars) then begin
   {$ELSE}
   if CharInSet(Text[i], TrimChars) then begin
   {$ENDIF}
    Inc(Index);
    Dec(Count);
   end else
    break;
  for i := Index + Count - 1 downto Index do
   {$IFDEF ICORE}
   if TUtils.CharsInSet(Text[i], TrimChars) then
   {$ELSE}
   if CharInSet(Text[i], TrimChars) then
   {$ENDIF}
    Dec(Count)
   else
    break;
  Result := Copy(Text, Index, Count);
except
  Result := '';
end;
end;

function TrimCopyAnsi(const Text: AnsiString; Index, Count: Integer): AnsiString;
const
  TrimChars : TCharsSet = [#9, #10, #13, #32, '"', ''''];
var
  i : Integer;
begin
  for i := Index to Index + Count - 1 do
    if Text[i] in TrimChars then
    begin
      Inc(Index);
      Dec(Count);
    end else
      break;
  for i := Index + Count - 1 downto Index do
    if Text[i] in TrimChars then
      Dec(Count)
    else
      break;
  Result := Copy(Text, Index, Count);
end;
{$ENDREGION}

{$IFNDEF ICORE}
function ReplaceChars(const Str: string;
                        const Chars: TCharsSet;
                        const Replace: Char): string;
var
  i: Longint;
begin
  SetLength(Result, Length(Str));
  for i := 1 to Length(Str) do
   if not (AnsiChar(Str[i]) in Chars) then
    Result[i] := Str[i]
   else
    Result[i] := Replace;
end;

function ReplaceCharsAnsi(const Str: AnsiString;
                        const Chars: TCharsSet;
                        const Replace: AnsiChar): AnsiString;
var
  i: Longint;
begin
  SetLength(Result, Length(Str));
  for i := 1 to Length(Str) do
   if not (AnsiChar(Str[i]) in Chars) then
    Result[i] := Str[i]
   else
    Result[i] := Replace;
end;

function ReplaceStr(const Str: string;
                      const SubStr: string;
                      const Replace: string): string;
var
  i: Integer;
  tmpstr, tmpstr1: string;
begin
  Result := Str;
  i := Pos(SubStr, Result);
  while i > 0 do begin
    tmpstr := Copy(Result, 1, i - 1);
    tmpstr1 := Copy(Result, i + Length(SubStr), Length(Result));
    Result := tmpstr + Replace + tmpstr1;
    i := Pos(SubStr, Result);
  end;
end;

function ReplaceStrAnsi(const Str: AnsiString;
                          const SubStr: AnsiString;
                          const Replace: AnsiString): AnsiString;
var
  i: Integer;
  tmpstr, tmpstr1: AnsiString;
begin
  Result := Str;
  i := Pos(SubStr, Result);
  if (i > 0) then begin
    tmpstr := Copy(Result, 1, i - 1) + Replace;
    tmpstr1 := Copy(Result, i + Length(SubStr), Length(Result));
    Result := tmpstr + ReplaceStrAnsi(tmpstr1, SubStr, Replace);
  end;
end;
{$ENDIF}

{$ENDREGION}

{$REGION 'TXMLParamsAnsi'}
constructor TXMLParamsAnsi.Create;
begin
  inherited;
end;

constructor TXMLParamsAnsi.Create(const Text: AnsiString);
var
  i          : Integer;
  Flag       : (F_BEGIN, F_NAME, F_VALUE);
  ParamIdx   : Integer;
  IndexBegin : Integer;
  ReadValue  : Boolean;
begin
  inherited Create;
  Flag       := F_BEGIN;
  ParamIdx   := -1;
  IndexBegin := 1;
  ReadValue  := False;
  for i := 1 to Length(Text) do
    case Flag of
      F_BEGIN :
        if Text[i] <> ' ' then
        begin
          ParamIdx := Length(FParams);
          SetLength(FParams, ParamIdx + 1);
          FParams[ParamIdx].Name  := '';
          FParams[ParamIdx].Value := '';
          Flag := F_NAME;
          IndexBegin := i;
        end;
      F_NAME :
        if Text[i] = '=' then
        begin
          FParams[ParamIdx].Name := TrimCopyAnsi(Text, IndexBegin, i - IndexBegin);
          Flag := F_VALUE;
          IndexBegin := i + 1;
        end;
      F_VALUE :
        if Text[i] <> ' ' then
          ReadValue := True
        else
          if ReadValue then
          begin
            FParams[ParamIdx].Value := TrimCopyAnsi(Text, IndexBegin, i - IndexBegin);
            Flag := F_BEGIN;
            ReadValue := False;
            ParamIdx := -1;
          end else
            continue;
    end;
    if ParamIdx <> -1 then
      FParams[ParamIdx].Value := TrimCopyAnsi(Text, IndexBegin, Length(Text) - IndexBegin + 1);
end;

destructor TXMLParamsAnsi.Destroy;
begin
  inherited;
end;

procedure TXMLParamsAnsi.Clear;
begin
  SetLength(FParams, 0);
end;

procedure TXMLParamsAnsi.AddParam(const Name: AnsiString;
                                    const Value: AnsiString);
var
  i: Integer;
begin
  for i := 0 to Count - 1 do
   if (ParamI[i].Name = Name) then begin
    FParams[i].Value := Value;
    Exit;
   end;
  SetLength(FParams, Count + 1);
  FParams[Count - 1].Name := Name;
  FParams[Count - 1].Value := Value;
end;

function TXMLParamsAnsi.Count: Integer;
begin
  try
    Result := Length(FParams);
  except
    Result := 0;
  end;
end;

function TXMLParamsAnsi.GetParam(const Name: AnsiString): TXMLParamAnsi;
var
  i : Integer;
begin
  Result := NullParamAnsi;
  for i := 0 to Count - 1 do
    if FParams[i].Name = Name then
    begin
      Result.Name  := PAnsiChar(FParams[i].Name);
      Result.Value := PAnsiChar(FParams[i].Value);
      Break;
    end;
end;

function TXMLParamsAnsi.GetParamI(Idx: Integer): TXMLParamAnsi;
begin
  Result.Name  := PAnsiChar(FParams[Idx].Name);
  Result.Value := PAnsiChar(FParams[Idx].Value);
end;
{$ENDREGION}

{$REGION 'TXMLAnsi'}
constructor TXMLAnsi.Create;
begin
  inherited;
  FParams := TXMLParamsAnsi.Create();
end;

constructor TXMLAnsi.Create(const FileName: {$IFDEF ICORE} AnsiString {$ELSE} string {$ENDIF};
                              const ClearData: Boolean = False);
begin
  inherited Create;
  LoadFromFile(FileName, ClearData);
end;

constructor TXMLAnsi.Create(const Text: AnsiString; BeginPos: Integer);
begin
  inherited Create;
  Parse(Text, BeginPos);
end;

destructor TXMLAnsi.Destroy;
//var
//  i : Integer;
begin
//  ClearParams;
  Clear;
  if (FParams <> nil) then
   FParams.Free;
//  ClearParams;
//  for i := 0 to Count - 1 do
//    NodeI[i].Free;
//  FParams.Free;
  inherited;
end;

procedure TXMLAnsi.Clear;
var
  i: Integer;
begin
  for i := 0 to Count - 1 do
   NodeI[i].Free;
  SetLength(FNode, 0);
end;

procedure TXMLAnsi.ClearParams;
begin
  Params.Clear;
end;

function TXMLAnsi.LoadFromFile(const FileName: {$IFDEF ICORE} AnsiString {$ELSE} string {$ENDIF};
                                const ClearData: Boolean = False): Boolean;
const
  UTF16_HEADER : Word = $FEFF;
var
  Stream  : TStreamFile;
  SourceText : AnsiString;
  Text    : AnsiString;
  Size    : Integer;
begin
  Result := False;
  Stream := TStreamFile.Create;
  Stream.Open(string(FileName), False);
  {$IFDEF ICORE}
  FFileName := TUtils.ExtractFileNameNoExt(FileName);
  {$ELSE}
  FFileName := ExtractFileName(FileName);
  FFileName := Copy(FFileName, 1, Length(FileName) - Length(ExtractFileExt(FileName)));
  {$ENDIF}
  if (Stream <> nil) and (Stream.Valid) then
  begin
    Size := Stream.Size;

    Stream.Position := 0;
    SetLength(SourceText, Size);
    Stream.Read(SourceText[1], Size);
    Text := AnsiString(Utf8ToAnsi(RawByteString(SourceText)));

    if ClearData then
     {$IFDEF ICORE}
     Text := AnsiString(TUtils.ReplaceChars(TStr(Text), [#13, #10, #9], ' '));
     {$ELSE}
     Text := ReplaceCharsAnsi(Text, [#13, #10, #9], ' ');
     {$ENDIF}
    Clear;
    Parse(Text, 1);
    Stream.Free;
    Result := True;
  end;
end;

function TXMLAnsi.LoadFromFile(const FileName: {$IFDEF ICORE} AnsiString {$ELSE} string {$ENDIF};
                                const Size: Integer;
                                const ClearData: Boolean = False): Boolean;
const
  UTF16_HEADER : Word = $FEFF;
var
  Stream  : TStreamFile;
  SourceText : AnsiString;
  Text    : AnsiString;
begin
  Result := False;
  Stream := TStreamFile.Create;
  Stream.Open(string(FileName), False);
  {$IFDEF ICORE}
  FFileName := TUtils.ExtractFileNameNoExt(FileName);
  {$ELSE}
  FFileName := ExtractFileName(FileName);
  FFileName := Copy(FFileName, 1, Length(FileName) - Length(ExtractFileExt(FileName)));
  {$ENDIF}
  if (Stream <> nil) then
  begin
    Stream.Position := 0;
    SetLength(SourceText, Size);
    Stream.Read(SourceText[1], Size);
    Text := AnsiString(Utf8ToAnsi(RawByteString(SourceText)));

    if ClearData then
     {$IFDEF ICORE}
     Text := AnsiString(TUtils.ReplaceChars(TStr(Text), [#13, #10, #9], ' '));
     {$ELSE}
     Text := AnsiString(ReplaceChars(string(Text), [#13, #10, #9], ' '));
     {$ENDIF}
    Clear;
    Parse(Text, 1);
    Stream.Free;
    Result := True;
  end;
end;

function TXMLAnsi.SaveToFile(const FileName: AnsiString): Boolean;
  function SaveNode(const Node: TXMLAnsi;
                      const NumTAB: Integer): AnsiString;
  var
    i: Integer;
    TextParams: AnsiString;
    TextTAB: AnsiString;
  begin
    Result := '';
    TextTAB := '';
    for i := 0 to NumTAB - 1 do
     TextTAB := TextTAB + TAB;
    Result := TextTAB;

    TextParams := '';
    if (Node.Params <> nil) then
     if (Node.Params.Count > 1) then
      for i := 0 to Node.Params.Count - 1 do
       TextParams := TextParams + CRLF + TextTAB + TAB + Node.Params.ParamI[i].Name + ' = "' + Node.Params.ParamI[i].Value + '"'
     else
      if (Node.Params.Count > 0) then
       TextParams := Node.Params.ParamI[0].Name + ' = "' + Node.Params.ParamI[0].Value + '" ';

    if (Node.Count = 0) and (Node.Content = '') then begin
      if (Node.Params <> nil) and (Node.Params.Count > 1) then
       Result := Result + '<' + Node.Tag + ' ' + TextParams + CRLF + TextTAB + '/>' + CRLF
      else
       Result := Result + '<' + Node.Tag + ' ' + TextParams + '/>' + CRLF;
    end else begin
      if (Node.Params <> nil) and (Node.Params.Count > 1) then
       Result := Result + '<' + Node.Tag + ' ' + TextParams + CRLF + TextTAB + '>' + CRLF
      else
       Result := Result + '<' + Node.Tag + ' ' + TextParams + '>' + CRLF;
      for i := 0 to Node.Count - 1 do
       Result := Result + SaveNode(Node.NodeI[i], NumTAB + 1);
      if Node.Content <> '' then
       Result := Result + TextTAB + TAB + Node.Content + CRLF;
      Result := Result + TextTAB + '</' + Node.Tag + '>' + CRLF;
    end;
  end;
var
  Stream: TStreamFile;
//  i: Integer;
  TextParams: AnsiString;
begin
  Result := False;
  Stream := TStreamFile.Create;
  Stream.Open(string(FileName), True);
  if Stream.Valid then begin
    TextParams := '';
    Stream.WriteTextAnsi(SaveNode(Self, 0));
    Result := True;
  end;
  Stream.Free;
end;

function TXMLAnsi.GetIDNode(const Tag: AnsiString): Integer;
var
  i: Integer;
begin
  Result := -1;
  for i := 0 to Count - 1 do
   if NodeI[i].Tag = Tag then begin
     Result := i;
     Break;
   end;
end;

function TXMLAnsi.AddNode(const Tag: AnsiString): TXMLAnsi;
//var
//  i: Integer;
begin
//  for i := 0 to Count - 1 do
//   if NodeI[i].Tag = Tag then begin
//    Result := NodeI[i];
//    Exit;
//   end;
  SetLength(FNode, Count + 1);
  FNode[Count - 1] := TXMLAnsi.Create;
  FNode[Count - 1].FTag := Tag;
  Result := FNode[Count - 1];
end;

function TXMLAnsi.DelNode(const Tag: AnsiString): Boolean;
var
  id: Integer;
begin
  id := GetIDNode(Tag);
  Result := DelNode(id);
end;

function TXMLAnsi.DelNode(const Index: Integer): Boolean;
var
  i: Integer;
begin
  Result := False;
  if (Index >= 0) and (Index < Count) then begin
    FNode[Index].Free;
    for i := Index to Count - 2 do
     FNode[i] := FNode[i + 1];
    SetLength(FNode, Count - 1);
    Result := True;
  end;
end;

function TXMLAnsi.Count: Integer;
begin
  Result := Length(FNode);
end;

function TXMLAnsi.ExistNode(const Tag: AnsiString): Boolean;
begin
  Result := (Node[Tag] <> nil);
end;

function TXMLAnsi.GetNode(const TagName: AnsiString): TXMLAnsi;
var
  i : Integer;
begin
  for i := 0 to Count - 1 do
    if FNode[i].Tag = TagName then
    begin
      Result := FNode[i];
      Exit;
    end;
  Result := nil;
end;

function TXMLAnsi.GetNodeI(Idx: Integer): TXMLAnsi;
begin
  Result := FNode[Idx];
end;

procedure TXMLAnsi.Parse(const Text: AnsiString; BeginPos: Integer);
var
  i, j : LongInt;
  Flag : (F_COMMENT, F_BEGIN, F_TAG, F_PARAMS, F_CONTENT, F_END, F_CDATA);
  BeginIndex : LongInt;
  TextTag    : AnsiChar;
  Len : LongInt;
  tmpstr: AnsiString;
begin
  TextTag := #0;
  Flag     := F_BEGIN;
  i := BeginPos - 1;
  BeginIndex := BeginPos;
  FContent := '';
  Len := Length(Text);
  while i < Len do
  begin
    Inc(i);
    case Flag of
      F_COMMENT :
        case Text[i] of
          '>' : Flag := F_BEGIN;
        end;
    // waiting for new tag '<...'
      F_BEGIN : begin
        tmpstr := TrimCopyAnsi(Text, i, 9);
        if (Text[i] = '<') and (Pos('<![CDATA[', tmpstr) = 1) then begin//(tmpstr = '<![CDATA[') then begin
           Flag := F_CDATA;
           BeginIndex := i - 1 + Pos('<![CDATA[', tmpstr) + 9;
        end else
         case Text[i] of
          '<' :
            begin
              Flag := F_TAG;
              BeginIndex := i + 1;
            end;
          '>' :
            begin
              Flag := F_END;
              Dec(i);
            end;
         end;
      end;
    // waiting for tag name '... ' or '.../' or '...>'
      F_TAG :
        begin
          case Text[i] of
            '>' : Flag := F_CONTENT;
            '/' : Flag := F_END;
            ' ' : Flag := F_PARAMS;
            '?', '!' :
              begin
                Flag := F_COMMENT;
                continue;
              end
          else
            continue;
          end;
          FTag := TrimCopyAnsi(Text, BeginIndex, i - BeginIndex);
          BeginIndex := i + 1;
        end;
    // parse tag parameters
      F_PARAMS :
        begin
          if (Text[i] = '''') or (Text[i] = '"') then
            if TextTag = #0 then
              TextTag := Text[i]
            else
              TextTag := #0;
          if TextTag = #0 then
          begin
            case Text[i] of
              '>' : Flag := F_CONTENT;
              '/' : Flag := F_END;
            else
              continue;
            end;
            if (FParams <> nil) then
             FParams.Free;
            FParams := TXMLParamsAnsi.Create(TrimCopyAnsi(Text, BeginIndex, i - BeginIndex));
            BeginIndex := i + 1;
          end;
        end;
    // parse tag content
      F_CONTENT :
        case Text[i] of
          '<' :
            begin
              FContent := TrimCopyAnsi(Text, BeginIndex, i - BeginIndex);
            // is new tag or tag closing?
              for j := i + 1 to Length(Text) do
                if Text[j] = '>' then
                begin
                  if TrimCopyAnsi(Text, i + 1, j - i - 1) <> '/' + FTag then
                  begin
                    SetLength(FNode, Length(FNode) + 1);
                    FNode[Length(FNode) - 1] := TXMLAnsi.Create(Text, i);
                    if FNode[Length(FNode) - 1].DataLen = 0 then
                      break;
                    i := i + FNode[Length(FNode) - 1].DataLen - 1;
                    BeginIndex := i + 1;
                  end else
                  begin
                    i := j - 1;
                    Flag := F_END;
                  end;
                  break;
                end;
            end
          end;
    // waiting for close tag
      F_END :
        if Text[i] = '>' then
        begin
          FDataLen := i - BeginPos + 1;
          break;
        end;
      F_CDATA: begin
          tmpstr := TrimCopyAnsi(Text, BeginIndex, Pos(']]>', Copy(Text, BeginIndex, Length(Text))) - 1);
          FTag := 'CDATA';
          FContent := tmpstr;//TrimCopy(tmpstr, 1, 1 + Pos(']]>', tmpstr) + 3);//Length(']]>'));
          FDataLen := (i - BeginPos) + 9 + Length(tmpstr) {+ 3 + 1};
          Break;
        end;
    end;
  end;
end;
{$ENDREGION}

end.

